home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #19 (Apr 87) / controls.fortran / control example.fort next >
Text File  |  1987-03-11  |  9KB  |  288 lines
  1.       PROGRAM CONTROLEXAMPLE
  2. *
  3. *   THIS PROGRAM IMPLEMENTS SIMPLE CONTROLS IN FORTRAN
  4. *
  5. *   AUTHOR: GLENN FORNEY
  6. *   DATE:   8/86
  7.  
  8.       IMPLICIT NONE                    ! HELPS KEEP US OUT OF TROUBLE
  9. *
  10. *   THE FOLLOWING INCLUDE FILES ARE INCLUDED WITH MS FORTRAN
  11. *   YOU SHOULD CHANGE THE PATHNAMES TO MATCH YOUR SETUP
  12. *
  13.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:window.inc
  14.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:dialog.inc
  15.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:event.inc
  16.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:menu.inc
  17.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
  18.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:quickdraw.inc
  19.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:misc.inc
  20.     
  21. *
  22. *  DECLARATIONS
  23. *
  24.       INTEGER*4 TOOLBX               ! THE TOOL BOX INTERFACE
  25.       INTEGER*4 WINDOW               ! GENERAL PURPOSE POINTER
  26.       INTEGER*2 RECT(4)              ! RECTANGLE COORDINATES
  27.       INTEGER*4 CONTROL_WINDOW       ! POINTER TO THE CONTROL WINDOW
  28.       INTEGER DUMMYHANDLE            ! HANDLE TO DUMMY WINDOW
  29.       INTEGER MENUHANDLE             ! HANDLE TO MENUS
  30. *
  31. * WCONTRLLIST IS AN OFFSET THAT GIVES A 
  32. * HANDLE TO THE FIRST CONTROL IN A WINDOW
  33. * HEX 8C = DECIMAL 140, SO WCONTROLLIST BEGINS AT THE
  34. * 140'TH BYTE IN THE WINDOW RECORD
  35. *
  36.       INTEGER WCONTROLLIST
  37.       PARAMETER (WCONTROLLIST = Z'8C')
  38. *
  39. * DECLARATIONS FOR VARIOUS EVENTS AND MOUSE DOWN LOCATIONS
  40. *        
  41.       INTEGER ACTIVATE,CONTROL_HAN,SAVEPORT
  42.       INTEGER MOUSEDOWN,UPDATEEVT,ACTIVATEEVT
  43.       PARAMETER (MOUSEDOWN=1,UPDATEEVT=6,ACTIVATEEVT=8)
  44.  
  45.       EVENTMASK = -1  ! PROCESS ALL EVENTS
  46.  
  47. *
  48. *  CLOSE MACFORTRAN I/O WINDOW (NEVER MAKE A DISPOSEWINDOW
  49. *       CALL ON THIS WINDOW SINCE WE DIDN'T ALLOCATE IT)
  50. *
  51.  
  52.       WINDOW = TOOLBX(FRONTWINDOW)
  53.       CALL TOOLBX(CLOSEWINDOW,WINDOW)
  54. *
  55. * INITIALIZE MENU
  56. *
  57.  
  58.       MENUHANDLE = TOOLBX(NEWMENU, 1,CHAR(7)//"OPTIONS")
  59.       CALL TOOLBX(APPENDMENU,MENUHANDLE,
  60.      +             CHAR(32)//"CONTROL WINDOW;DUMMY WINDOW;QUIT")
  61.       CALL TOOLBX(INSERTMENU,MENUHANDLE,0)
  62.       CALL TOOLBX(DRAWMENUBAR)
  63. *
  64. *   READ IN CONTROL_WINDOW WITH "REGULAR" CONTROLS FROM 
  65. *   RESOURCE ID 128, 0 MEANS ALLOCATE STORAGE ON HEAP, -1 MEANS
  66. *   BRING WINDOW IN FRONT OF ALL OTHER WINDOWS
  67. *
  68.         CONTROL_WINDOW = TOOLBX(GETNEWDIALOG,128,0,-1)
  69. *
  70. *   PLACE INFORMATION IN CONTROL_WINDOW'S REFCON FIELD 
  71. *   TO BE USED BY APPLICATION
  72. *
  73.       CALL INITVALUES(CONTROL_WINDOW,2)
  74. *
  75. *   SET UP DUMMY WINDOW TO MAKE SURE UPDATE AND ACTIVATE EVENTS
  76. *   ARE HANDLED RIGHT
  77. *
  78.  
  79.       RECT(1) = 40
  80.       RECT(2) = 30
  81.       RECT(3) = 300
  82.       RECT(4) = 270
  83.       DUMMYHANDLE = TOOLBX(NEWWINDOW,0,RECT,
  84.      +          CHAR(12)//"DUMMY WINDOW",.TRUE.,4,-1,.TRUE.,0)
  85.      
  86.       RECT(1) = 25 ! WINDOWDRAG CONTSTRAINTS
  87.       RECT(2) = 25
  88.       RECT(3) = 300
  89.       RECT(4) = 500
  90. *
  91. *  MAIN EVENT PROCESSING LOOP
  92. *
  93.       DO
  94.         IF (TOOLBX(GETNEXTEVENT,EVENTMASK,EVENTRECORD)) THEN
  95.  
  96.           SELECT CASE (WHAT)
  97.  
  98.             CASE (MOUSEDOWN)      ! HANDLE MOUSE DOWN
  99.               CALL DOMOUSEDOWN(WHERE,WINDOW,DUMMYHANDLE,
  100.      1               CONTROL_WINDOW,RECT,EVENTRECORD)
  101.      
  102.             CASE(UPDATEEVT)     ! HANDLE UPDATE EVENT
  103. *
  104. *  MUST ALWAYS SET THE PORT TO THE WINDOW WHERE OUTPUT IS TO OCCUR
  105. *  MESSAGE IS PASSED TO US IN THE EVENT RECORD AND IS A POINTER
  106. *  TO THE WINDOW BEING UPDATED
  107. *
  108.               CALL TOOLBX(GETPORT,SAVEPORT)  ! SAVE THE PORT
  109.               CALL TOOLBX(SETPORT,MESSAGE)   ! SET PORT TO UPDATE WINDOW
  110.               CALL TOOLBX(BEGINUPDATE,MESSAGE) ! ALWAYS USE THIS BEFORE UPDATE
  111.               CALL TOOLBX(DRAWCONTROLS,MESSAGE) ! DRAW THE CONTROLS
  112.               CALL TOOLBX(ENDUPDATE,MESSAGE)  !  ALWAYS USE THIS AFTER UPDATE
  113.               CALL TOOLBX(SETPORT,SAVEPORT)  ! RESTORE TO PREVIOUS PORT
  114.  
  115.             CASE(ACTIVATEEVT)    ! HANDLE ACTIVATE EVENT
  116.               CALL TOOLBX(SETPORT,MESSAGE)
  117.               ACTIVATE = 255  !  UNHILIGHT CONTROLS
  118.               IF(MOD(MODIFIERS,2).EQ.1)ACTIVATE = 0 ! HILIGHT CONTROLS
  119.               CONTROL_HAN = LONG(MESSAGE+WCONTROLLIST) ! FIRST CONTROL
  120. *
  121. * LOOP THROUGH ALL CONTROLS IN A WINDOW
  122. *
  123.               WHILE(CONTROL_HAN.NE.0)
  124.                 CALL TOOLBX(HILITECONTROL,CONTROL_HAN,ACTIVATE)
  125.                 CONTROL_HAN = LONG(LONG(CONTROL_HAN)) ! NEXT CONTROL
  126.               REPEAT
  127.               
  128.             CASE DEFAULT
  129.           END SELECT
  130.         END IF
  131.       REPEAT
  132.       END
  133.       SUBROUTINE DOMOUSEDOWN(WHERE,WINDOW,DUMMYWINDOW,
  134.      1             CONTROL_WINDOW,RECT,EVENTRECORD)
  135. *
  136. *  THIS ROUTINE HANDLES MOUSE DOWN EVENTS
  137. *
  138.       IMPLICIT NONE
  139.       INTEGER WINDOW,CONTROL_WINDOW,MOUSELOC
  140.       INTEGER TOOLBX,SIZE
  141.       INTEGER SAVEPORT,TTY_CT,WHICH_CTRL
  142.       INTEGER*2 EVENTRECORD(8)    ! OVERLYING STRUCTURE
  143.       INTEGER*2 WHERE(2),RECT(4),INVAL_RECT(4),MENUSELECTION(2)
  144.       LOGICAL FLAG
  145.       INTEGER QUIT, OPTIONS,CIRCLES,MENUDATA,DUMMY,DUMMYWINDOW
  146.       PARAMETER (QUIT=3,OPTIONS=1,CIRCLES=1,DUMMY=2)
  147.       
  148.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:window.inc
  149.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:menu.inc
  150.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
  151.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:quickdraw.inc
  152.     
  153. *
  154. *  MOUSE DOWN LOCATIONS
  155. *
  156.       INTEGER MENUBAR,SYSTEMWINDOW,CONTENTREGION,DRAGREGION
  157.       INTEGER GROWREGION,GOAWAYREGION,NONE
  158.       PARAMETER (MENUBAR=1,SYSTEMWINDOW=2,CONTENTREGION=3)
  159.       PARAMETER (DRAGREGION=4,GOAWAYREGION=6,NONE=0)
  160.       PARAMETER (GROWREGION=5)
  161.       EQUIVALENCE (MENUDATA,MENUSELECTION)
  162.         
  163.       MOUSELOC = TOOLBX(FINDWINDOW,WHERE,WINDOW)
  164.  
  165.       IF (MOUSELOC=MENUBAR) THEN
  166.         MENUDATA = TOOLBX(MENUSELECT,WHERE)
  167.         SELECT CASE (MENUSELECTION(1))
  168.           CASE (OPTIONS)           ! THE "OPTIONS" MENU WAS SELECTED
  169.  
  170.           SELECT CASE (MENUSELECTION(2))
  171.  
  172.             CASE (CIRCLES)
  173.                WINDOW = CONTROL_WINDOW
  174.             CASE (DUMMY)
  175.                WINDOW = DUMMYWINDOW
  176.             CASE (QUIT)
  177.                STOP
  178.           END SELECT
  179.  
  180.           CALL TOOLBX(SHOWWINDOW,WINDOW)
  181.           CALL TOOLBX(SELECTWINDOW,WINDOW)
  182.           CALL TOOLBX(HILITEMENU,0)
  183.  
  184.           CASE DEFAULT         ! JUST PLAYING WITH THE MOUSE
  185.  
  186.         END SELECT
  187.  
  188.        ELSE IF (MOUSELOC=CONTENTREGION) THEN
  189.         CALL TOOLBX(SELECTWINDOW,WINDOW)
  190. *
  191. *   HANDLE MOUSEDOWN IN CONTROL
  192. * 
  193.         CALL TOOLBX(GETPORT,SAVEPORT)   ! SAVE CURRENT PORT
  194.         CALL TOOLBX(SETPORT,WINDOW)     ! SET PORT TO SELECTED WINDOW
  195.         CALL TOOLBX(GLOBALTOLOCAL,WHERE)  ! CONVERT TO LOCAL COORDINATES
  196.         CALL INCONTROL(WHERE,WINDOW)    ! HANDLE IT IF MOUSE IS IN CONTROL
  197.         CALL TOOLBX(SETPORT,SAVEPORT) ! RESTORE PORT
  198.  
  199.        ELSE IF (MOUSELOC=DRAGREGION) THEN 
  200.         CALL TOOLBX(DRAGWINDOW,WINDOW,WHERE,RECT)
  201.  
  202.  
  203.        ELSE IF (MOUSELOC=GOAWAYREGION) THEN
  204.         IF (TOOLBX(TRACKGOAWAY,WINDOW,WHERE))
  205.      +     CALL TOOLBX(HIDEWINDOW,WINDOW)
  206.       END IF
  207.       RETURN
  208.       END
  209.       SUBROUTINE INCONTROL(WHERE,WINDOW)
  210. *
  211. *  HANDLE EVENT IF MOUSE IS DOWN IN CONTROL
  212. *
  213.       IMPLICIT NONE
  214.       INTEGER*2 WHERE(2)
  215.       INTEGER WHICH_CTRL,WINDOW,PART_NUMBER,IVALUE4,TOOLBX
  216.       
  217.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
  218. *
  219. * DEFINE SYMBOLIC NAMES FOR CONTROL ITEMS
  220. * NAMING CONVENTION TAKEN FROM INSIDE MACINTOSH
  221. *
  222.       INTEGER INBUTTON, INCHECKBOX, INUPBUTTON, INDOWNBUTTON
  223.       INTEGER INPAGEUP, INPAGEDOWN, INTHUMB
  224.       PARAMETER (INBUTTON=10, INCHECKBOX=11, INUPBUTTON=20)
  225.       PARAMETER (INDOWNBUTTON=21, INPAGEUP=22, INPAGEDOWN=23)
  226.       PARAMETER (INTHUMB=129)
  227.       INTEGER PUSHBUTPROC,CHECKBOXPROC,RADIOBUTPROC,SCROLLBARPROC
  228.       PARAMETER (PUSHBUTPROC=0,CHECKBOXPROC=1,RADIOBUTPROC=2)
  229.       PARAMETER (SCROLLBARPROC=16)
  230.       INTEGER MENUBAR,SYSTEMWINDOW,CONTENTREGION,DRAGREGION
  231.       INTEGER GROWREGION,GOAWAYREGION
  232.       PARAMETER (MENUBAR=1,SYSTEMWINDOW=2,CONTENTREGION=3)
  233.       PARAMETER (DRAGREGION=4,GOAWAYREGION=6)
  234.       PARAMETER (GROWREGION=5)
  235.  
  236.       IF(TOOLBX(FINDCONTROL,WHERE,WINDOW,WHICH_CTRL).NE.0)THEN
  237. *
  238. *    IS MOUSEUP IN CONTROL? IF SO HANDLE CONTROL
  239. *
  240.         PART_NUMBER = TOOLBX(TRACKCONTROL,WHICH_CTRL,WHERE,0)
  241.         IF(PART_NUMBER.EQ.INBUTTON)THEN
  242. *
  243. *    BUTTON CONTROL DOES NOT NEED TO HAVE ITS VALUE CHANGED
  244. *
  245.          ELSE IF(PART_NUMBER.EQ.INCHECKBOX)THEN    
  246.           IVALUE4 = 1 - TOOLBX(GETCTLVALUE,WHICH_CTRL)
  247.           CALL TOOLBX(SETCTLVALUE,WHICH_CTRL,IVALUE4)
  248. *
  249. *   IF WE WERE HANDLING SCROLL BARS THEN CODE TO HANDLE MOUSE DOWN
  250. *   IN SCROLL BAR PARTS WOULD GO HERE
  251. *
  252.         ENDIF
  253.       ENDIF
  254.       RETURN
  255.       END
  256.       SUBROUTINE INITVALUES(WINDOW,IVALUE)
  257. *
  258. *   INITIALIZE THE REFCON FIELD OF ALL CONTROLS IN WINDOW
  259. *
  260.       IMPLICIT NONE
  261.       INTEGER WINDOW, IVALUE, CONTROL_HAN,IVAL_CTRL
  262.       
  263.           include XP40-6:SoftwareDev:MacFortran:IncludeFiles:window.inc
  264.     include XP40-6:SoftwareDev:MacFortran:IncludeFiles:control.inc
  265.     
  266. *
  267. * HANDLE TO LIST OF CONTROLS OF THIS WINDOW
  268. *
  269.       INTEGER WCONTROLLIST
  270.       PARAMETER (WCONTROLLIST = Z'8C')
  271. *
  272. *   INITIALIZE THE WINDOW REFCON FIELD
  273. *
  274.       CALL TOOLBX(SETWREFCON,WINDOW,IVALUE)
  275.       CONTROL_HAN = LONG(WINDOW+WCONTROLLIST) ! FIRST CONTROL IN WINDOW
  276.       IVAL_CTRL = 1
  277.       IF(IVALUE.EQ.1)IVAL_CTRL = 129
  278.       WHILE(CONTROL_HAN.NE.0)
  279.         CALL TOOLBX(SETCREFCON,CONTROL_HAN,IVAL_CTRL)
  280.         IVAL_CTRL = IVAL_CTRL + 1
  281. *
  282. * NEXT CONTROL IN WINDOW (LAST CONTROL IN WINDOW POINTS TO 0)
  283. *
  284.         CONTROL_HAN = LONG(LONG(CONTROL_HAN))
  285.       REPEAT
  286.       RETURN
  287.       END
  288.